home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / TReg.Frm < prev    next >
Text File  |  1997-06-14  |  14KB  |  468 lines
  1. VERSION 5.00
  2. Begin VB.Form FTestRegistry 
  3.    Caption         =   "Test Registry"
  4.    ClientHeight    =   5910
  5.    ClientLeft      =   990
  6.    ClientTop       =   2520
  7.    ClientWidth     =   8280
  8.    Icon            =   "TReg.frx":0000
  9.    LinkTopic       =   "Form1"
  10.    ScaleHeight     =   5910
  11.    ScaleWidth      =   8280
  12.    Begin VB.ListBox lstItem 
  13.       Height          =   840
  14.       ItemData        =   "TReg.frx":0CFA
  15.       Left            =   156
  16.       List            =   "TReg.frx":0CFC
  17.       TabIndex        =   10
  18.       Top             =   4200
  19.       Width           =   1596
  20.    End
  21.    Begin VB.ListBox lstNode 
  22.       Height          =   840
  23.       ItemData        =   "TReg.frx":0CFE
  24.       Left            =   156
  25.       List            =   "TReg.frx":0D05
  26.       TabIndex        =   9
  27.       Top             =   2952
  28.       Width           =   1596
  29.    End
  30.    Begin VB.CommandButton cmdTestClass 
  31.       Caption         =   "Test All Classes"
  32.       Height          =   396
  33.       Left            =   156
  34.       TabIndex        =   7
  35.       Top             =   1080
  36.       Width           =   1596
  37.    End
  38.    Begin VB.CommandButton cmdTestFunc 
  39.       Caption         =   "Test All Functions"
  40.       Height          =   396
  41.       Left            =   156
  42.       TabIndex        =   6
  43.       Top             =   576
  44.       Width           =   1596
  45.    End
  46.    Begin VB.ListBox lstRoot 
  47.       Height          =   840
  48.       ItemData        =   "TReg.frx":0D12
  49.       Left            =   150
  50.       List            =   "TReg.frx":0D19
  51.       TabIndex        =   4
  52.       Top             =   1785
  53.       Width           =   1590
  54.    End
  55.    Begin VB.TextBox txtValue 
  56.       Height          =   285
  57.       Left            =   156
  58.       TabIndex        =   2
  59.       Top             =   5421
  60.       Width           =   1596
  61.    End
  62.    Begin VB.TextBox txtOut 
  63.       BeginProperty Font 
  64.          Name            =   "Courier New"
  65.          Size            =   7.5
  66.          Charset         =   0
  67.          Weight          =   400
  68.          Underline       =   0   'False
  69.          Italic          =   0   'False
  70.          Strikethrough   =   0   'False
  71.       EndProperty
  72.       Height          =   5610
  73.       Left            =   1932
  74.       MultiLine       =   -1  'True
  75.       ScrollBars      =   3  'Both
  76.       TabIndex        =   1
  77.       Top             =   96
  78.       Width           =   6168
  79.    End
  80.    Begin VB.CommandButton cmdIterate 
  81.       Caption         =   "Iterate Node"
  82.       Height          =   396
  83.       Left            =   156
  84.       TabIndex        =   0
  85.       Top             =   96
  86.       Width           =   1584
  87.    End
  88.    Begin VB.Label lbl 
  89.       Caption         =   "Item:"
  90.       Height          =   252
  91.       Index           =   4
  92.       Left            =   150
  93.       TabIndex        =   11
  94.       Top             =   3972
  95.       Width           =   972
  96.    End
  97.    Begin VB.Label lbl 
  98.       Caption         =   "Node:"
  99.       Height          =   252
  100.       Index           =   3
  101.       Left            =   150
  102.       TabIndex        =   8
  103.       Top             =   2712
  104.       Width           =   972
  105.    End
  106.    Begin VB.Label lbl 
  107.       Caption         =   "Root:"
  108.       Height          =   252
  109.       Index           =   2
  110.       Left            =   150
  111.       TabIndex        =   5
  112.       Top             =   1548
  113.       Width           =   972
  114.    End
  115.    Begin VB.Label lbl 
  116.       Caption         =   "Value:"
  117.       Height          =   255
  118.       Index           =   1
  119.       Left            =   156
  120.       TabIndex        =   3
  121.       Top             =   5160
  122.       Width           =   975
  123.    End
  124. End
  125. Attribute VB_Name = "FTestRegistry"
  126. Attribute VB_GlobalNameSpace = False
  127. Attribute VB_Creatable = False
  128. Attribute VB_PredeclaredId = True
  129. Attribute VB_Exposed = False
  130. Option Explicit
  131.  
  132. Implements IUseRegItems
  133. Private sOut As String
  134. Private hRootCur As Long
  135. Private nodeCur As New CRegNode, nodeRoot As New CRegNode
  136. Private itemCur As New CRegItem
  137. Private valCur As Variant
  138.  
  139. Private Sub cmdExit_Click()
  140.     Unload Me
  141. End Sub
  142.  
  143. Private Sub cmdIterate_Click()
  144.     Dim node As New CRegNode, f As Boolean
  145.     txtOut.Text = sEmpty
  146.     sOut = sEmpty
  147.     HourGlass Me
  148.     On Error GoTo IterateFail
  149.     node.Key(hRootCur) = nodeCur.Name
  150.     node.WalkAllNodes Me, node, 0
  151.     txtOut = sOut
  152.     HourGlass Me
  153.     Exit Sub
  154. IterateFail:
  155.     txtOut = "Can't iterate item: " & Err.Description
  156.     HourGlass Me
  157. End Sub
  158.  
  159. Private Sub cmdTestClass_Click()
  160.     Dim hKey As Long, hSubKey As Long, hSubSubKey As Long
  161.     Dim ordDispose As Long, s As String, e As Long
  162.     Dim node As CRegNode
  163.     Dim nodesTop As New CRegNode
  164.     ' Connect to first-level node by name
  165.     nodesTop.Create "Software\VB and VBA Program Settings"
  166.     ' Connect HKEY_CLASSES_ROOT node
  167.     nodesTop.Key = HKEY_CLASSES_ROOT
  168.     ' Connect VBCore.CAbout node in current node (HKEY_CLASSES_ROOT)
  169.     nodesTop.Key = "VisualCore.CAbout"
  170.     ' Connect Software node in specified root HKEY_LOCAL_MACHINE
  171.     nodesTop.Key(HKEY_LOCAL_MACHINE) = "Software"
  172.     ' Open first node of current node
  173.     nodesTop.Key(nodesTop.Key) = 1
  174.     ' Connect to first-level node by name
  175.     nodesTop.Create "Software\VB and VBA Program Settings"
  176.  
  177.     s = s & "Opened VB and VBA node" & sCrLf
  178.     ' Add a node
  179.     Set node = nodesTop.AddNode("FirstLevel")
  180.     s = s & "Created new FirstLevel key" & sCrLf
  181.     ' Add two node to that node
  182.     node.AddNode "SecondLevel1"
  183.     s = s & "Created new SecondLevel1 key" & sCrLf
  184.     node.AddNode "SecondLevel2"
  185.     s = s & "Created new SecondLevel2 key" & sCrLf
  186.     ' Add a default item (must be a string)
  187.     node.AddItem "Default"
  188.     s = s & "Created value: default" & sCrLf
  189.     Dim ab() As Byte
  190.     ' Add bytes item
  191.     ab = "The bytes"
  192.     node.AddItem ab, "Bytes"
  193.     s = s & "Created value: Bytes" & sCrLf
  194.     ' Add string item
  195.     node.AddItem "A String", "String"
  196.     s = s & "Created value: String" & sCrLf
  197.     ' Add numeric item
  198.     node.AddItem 5&, "Number"
  199.     s = s & "Created value: Number" & sCrLf
  200.     ' Add string item containing embedded environment variable
  201.     node.AddItem "A %TEMP% string", "ExpandString"
  202.     s = s & "Created value: ExpandString" & sCrLf
  203.     
  204.     Dim v As Variant
  205.     ' Get default item
  206.     v = node.Items(sEmpty)
  207.     s = s & "Get default: " & v & sCrLf
  208.     ' Get Bytes item
  209.     v = node.Items("Bytes")
  210.     ab = v
  211.     s = s & "Get Bytes: " & HexDump(ab, ehdSample8) & sCrLf
  212.     ' Get String item
  213.     v = node.Items("String")
  214.     s = s & "Get String: " & v & sCrLf
  215.     ' Get Number item
  216.     v = node.Items("Number")
  217.     s = s & "Get Number: " & v & sCrLf
  218.     v = node.Items("ExpandString")
  219.     ' Get item with environment variable in string
  220.     s = s & "Get ExpandString: " & v & sCrLf
  221.     
  222.     v = node.Items(1)
  223.     s = s & "Get unknown item: " & VarToStr(v) & sCrLf
  224.     
  225.     ' Add some more values by string index
  226.     node("SecondLevel1").AddItem "DefaultString"
  227.     node("SecondLevel1").AddItem "Stuff", "Value1"
  228.     node("SecondLevel2").AddItem 689, "Value1"
  229.     
  230.     ' Iterate node by numeric index
  231.     Dim i As Long, sName As String
  232.     For i = 0 To node.NodeCount - 1
  233.         sName = node.Nodes(i).Name
  234.         s = s & "Node(" & i & "): " & sName & sCrLf
  235.     Next
  236.     
  237.     ' Iterate items by numeric index
  238.     For i = 0 To node.ItemCount - 1
  239.         With node.Items(i)
  240.             s = s & .Name & "(" & i & ") = " & VarToStr(.Value) & sCrLf
  241.         End With
  242.     Next
  243.     
  244.     ' Iterate node with For Each
  245.     s = s & node.Name & sCrLf
  246.     Dim item As CRegItem
  247.     For Each item In node.Items
  248.         s = s & item.Name & " : " & VarToStr(item.Value) & sCrLf
  249.     Next
  250.     Dim nodesSub As CRegNode
  251.     ' Iterate subnodes with For Each
  252.     For Each nodesSub In node
  253.         s = s & nodesSub.Name & sCrLf
  254.         ' Iterate items with For Each
  255.         For Each item In nodesSub.Items
  256.             s = s & item.Name & " = " & VarToStr(item.Value) & sCrLf
  257.         Next
  258.     Next
  259.     
  260.     node.WalkNodes Me, 0
  261.     s = s & sOut
  262.     sOut = sEmpty
  263.     node.WalkItems Me, 0
  264.     s = s & sOut
  265.     sOut = sEmpty
  266.     Call node.WalkAllNodes(Me, node, 0)
  267.     s = s & sOut
  268.     sOut = sEmpty
  269.     
  270.     node.RemoveItem 1
  271.     node.RemoveItem "String"
  272.     
  273.     Dim f As Boolean
  274.     f = nodesTop.RemoveNode("FirstLevel", AllChild:=False)
  275.     s = s & "Delete one node succeeded: " & f & sCrLf
  276.                          
  277.     f = nodesTop.RemoveNode("FirstLevel")
  278.     s = s & "Delete all nodes succeeded: " & f & sCrLf
  279.     
  280.     BugMessage s
  281.     txtOut = s
  282. End Sub
  283.  
  284. Private Sub cmdTestFunc_Click()
  285.     Dim hKey As Long, hSubKey As Long, hSubSubKey As Long
  286.     Dim ordDispose As Long, s As String, e As Long
  287.     e = RegOpenKeyEx(HKEY_CURRENT_USER, _
  288.                      "Software\VB and VBA Program Settings", _
  289.                      0&, KEY_ALL_ACCESS, hKey)
  290.     If e Then Exit Sub Else s = s & "Opened VB and VBA key" & sCrLf
  291.     e = RegCreateKeyEx(hKey, "FirstLevel", 0&, sEmpty, _
  292.                        REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, _
  293.                        pNull, hSubKey, ordDispose)
  294.     If e Then Exit Sub
  295.     e = RegCloseKey(hKey)
  296.     If ordDispose = REG_CREATED_NEW_KEY Then
  297.         s = s & "Created new FirstLevel key" & sCrLf
  298.     Else
  299.         s = s & "Found existing FirstLevel key" & sCrLf
  300.     End If
  301.     Dim fExisted As Boolean
  302.     e = CreateRegNode(hSubKey, "SecondLevel1", hSubSubKey, fExisted)
  303.     If e Then Exit Sub
  304.     If fExisted Then
  305.         s = s & "Found existing SecondLevel1 key" & sCrLf
  306.     Else
  307.         s = s & "Created new SecondLevel1 key" & sCrLf
  308.     End If
  309.     e = RegCloseKey(hSubSubKey)
  310.     
  311.     e = CreateRegNode(hSubKey, "SecondLevel2", hSubSubKey)
  312.     If e Then Exit Sub
  313.     If fExisted Then
  314.         s = s & "Found existing SecondLevel2 key" & sCrLf
  315.     Else
  316.         s = s & "Created new SecondLevel2 key" & sCrLf
  317.     End If
  318.     e = RegCloseKey(hSubSubKey)
  319.     
  320.     e = CreateRegValue("Default", hSubKey)
  321.     If e Then Exit Sub
  322.     s = s & "Created value: default" & sCrLf
  323.     Dim ab() As Byte
  324.     ab = "The bytes"
  325.     e = CreateRegValue(ab, hSubKey, "Bytes")
  326.     If e Then Exit Sub
  327.     s = s & "Created value: Bytes" & sCrLf
  328.     e = CreateRegValue("A String", hSubKey, "String")
  329.     If e Then Exit Sub
  330.     s = s & "Created value: String" & sCrLf
  331.     e = CreateRegValue(5&, hSubKey, "Number")
  332.     If e Then Exit Sub
  333.     s = s & "Created value: Number" & sCrLf
  334.     e = CreateRegValue("A %TEMP% string", hSubKey, "ExpandString")
  335.     If e Then Exit Sub
  336.     s = s & "Created value: ExpandString" & sCrLf
  337.     
  338.     Dim v As Variant
  339.     e = GetRegValue(hSubKey, sEmpty, v)
  340.     If e Then Exit Sub
  341.     s = s & "Get default: " & v & sCrLf
  342.     e = GetRegValue(hSubKey, "Bytes", v)
  343.     If e Then Exit Sub
  344.     ab = v
  345.     s = s & "Get Bytes: " & HexDump(ab, ehdSample8) & sCrLf
  346.     e = GetRegValue(hSubKey, "String", v)
  347.     If e Then Exit Sub
  348.     s = s & "Get String: " & v & sCrLf
  349.     e = GetRegValue(hSubKey, "Number", v)
  350.     If e Then Exit Sub
  351.     s = s & "Get Number: " & v & sCrLf
  352.     e = GetRegValue(hSubKey, "ExpandString", v)
  353.     If e Then Exit Sub
  354.     s = s & "Get ExpandString: " & v & sCrLf
  355.     
  356.     Dim i As Long, sName As String
  357.     Do
  358.         e = GetRegValueNext(hSubKey, i, sName, v)
  359.         If e = 0 Then
  360.             s = s & "Get item " & i & ": " & VarToStr(v) & sCrLf
  361.         End If
  362.         i = i + 1
  363.     Loop While e = 0
  364.     
  365.     e = RegCloseKey(hSubKey)
  366.     e = DeleteOneRegNode(HKEY_CURRENT_USER, _
  367.                          "Software\VB and VBA Program Settings\FirstLevel")
  368.     s = s & "Delete one node succeeded: " & (e = 0) & sCrLf
  369.                          
  370.     e = DeleteRegNodes(HKEY_CURRENT_USER, _
  371.                        "Software\VB and VBA Program Settings\FirstLevel")
  372.     s = s & "Delete all nodes succeeded: " & (e = 0) & sCrLf
  373.     
  374.     
  375.     Do
  376.         e = GetRegValueNext(hSubKey, i, sName, v)
  377.         If e = 0 Then
  378.             s = s & "Get item " & i & ": " & VarToStr(v) & sCrLf
  379.         End If
  380.         i = i + 1
  381.     Loop While e = 0
  382.     
  383.     BugMessage s
  384.     txtOut = s
  385. End Sub
  386.  
  387. Private Sub Form_Activate()
  388.     lstRoot.AddItem "Classes Root"
  389.     lstRoot.ItemData(0) = HKEY_CLASSES_ROOT
  390.     lstRoot.AddItem "Current User"
  391.     lstRoot.ItemData(1) = HKEY_CURRENT_USER
  392.     lstRoot.AddItem "Local Machine"
  393.     lstRoot.ItemData(2) = HKEY_LOCAL_MACHINE
  394.     lstRoot.AddItem "Users"
  395.     lstRoot.ItemData(3) = HKEY_USERS
  396.     lstRoot.AddItem "Current Config"
  397.     lstRoot.ItemData(4) = HKEY_CURRENT_CONFIG
  398.     If Not IsNT Then
  399.         lstRoot.AddItem "Dynamic Data"
  400.         lstRoot.ItemData(5) = HKEY_DYN_DATA
  401.     End If
  402.     lstRoot.ListIndex = 1
  403. End Sub
  404.  
  405. Private Sub lstItem_Click()
  406.     Set itemCur = nodeCur.Items(lstItem.Text)
  407.     txtValue = VarToStr(itemCur.Value)
  408. End Sub
  409.  
  410. Private Sub lstNode_Click()
  411. With lstItem
  412.     txtValue = sEmpty
  413.     Set nodeCur = nodeRoot.Nodes(lstNode.Text)
  414.     Dim item As CRegItem
  415.     .Clear
  416.     For Each item In nodeCur.Items
  417.         .AddItem item.Name
  418.     Next
  419.     If .ListCount Then .ListIndex = 0
  420. End With
  421. End Sub
  422.  
  423. Private Sub lstRoot_Click()
  424. With lstNode
  425.     hRootCur = lstRoot.ItemData(lstRoot.ListIndex)
  426.     nodeRoot.Create sEmpty, hRootCur
  427.     Dim node As CRegNode
  428.     .Clear
  429.     For Each node In nodeRoot
  430.         .AddItem node.Name
  431.     Next
  432.     If .ListCount Then .ListIndex = 0
  433. End With
  434. End Sub
  435.  
  436. Private Function IUseRegItems_UseItem(item As CRegItem, _
  437.                                       ByVal iLevel As Long) As Boolean
  438. With item
  439.     sOut = sOut & Space$((iLevel - 1) * 4) & " > " & _
  440.                   .Name & " : " & VarToStr(.Value) & sCrLf
  441. End With
  442. End Function
  443.  
  444. Private Function IUseRegItems_UseNode(node As CRegNode, _
  445.                                       ByVal iLevel As Long) As Boolean
  446. With node
  447.     sOut = sOut & Space$((iLevel) * 4) & .Name & " : " & sCrLf
  448.     .WalkItems Me, iLevel
  449.     DoEvents
  450. End With
  451. End Function
  452.  
  453. Function VarToStr(ByVal v As Variant) As String
  454.     Select Case VarType(v)
  455.     Case vbArray Or vbByte
  456.         Dim ab() As Byte
  457.         ab = v
  458.         VarToStr = HexDump(ab, ehdSample8)
  459.     Case vbLong
  460.         VarToStr = "&H" & FmtHex(v, 8) & " (" & CStr(v) & ")"
  461.     Case Else
  462.         VarToStr = CStr(v)
  463.     End Select
  464. End Function
  465.  
  466.  
  467.  
  468.